Un banco quiere disponer de un modelo de credit scoring para lo cual dispone de un conjunto de datos con 1.646 registros de clientes a los que concedió un crédito. Esta base de datos contiene siete variables numéricas y cuatro categóricas. La variable denominada CLASE muestra la información de si el cliente devolvió el crédito o no y toma dos valores: SI y NO.
La descripción de la base de datos es la siguiente:
TIPO_VIVIENDA: Propiedad libre, Propiedad hipotecada, Alquiler, Vive con la familia y Otros.
VALOR_VIVIENDA: Valor de la vivienda.
PATRIMONIO: Montante del patrimonio.
NACIONALIDAD: Español y Extranjero.
IMPORTE: Importe del préstamo.
CUOTA: Cuota que paga al banco por el préstamo concedido.
INGRESOS: Ingresos del peticionario del crédito.
SALDO: Saldo que mantiene en la cuenta bancaria.
EDAD: Edad.
ESTADO_CIVIL: Esta variable toma tres valores: Casado, Separado y Soltero.
CLASE: Muestra dos valores, No para los que no pagaron el crédito y SI para los clientes que sí cumplieron con el pago del crédito.
Instalamos los paquetes que necesitaremos durante nuestro análisis.
rm(list = ls())
suppressWarnings(suppressPackageStartupMessages({
library(skimr)
library(funModeling)
library(inspectdf)
library(DataExplorer)
library(PerformanceAnalytics)
library(corrplot)
library(flextable)
library(kableExtra)
library(officer)
library(rmarkdown)
library(magrittr)
library(tidyverse)
library(patchwork)
library(ggthemes)
library(ggpubr)
library(data.table)
library(fastDummies)
library(naniar)
library(mice)
library(VIM)
library(gmodels)
library(dlookr)
library(randomForest)
library(dlookr)
library(sampling)
library(DMwR)
library(car)
}))Lectura de la base de datos and convirtiéndolo en un data.table.
datos = read.csv("datos_credit_scoring.csv")
datos = as.data.table(datos)Descripción de la base de datos
Vemos la estructura de nuestra base de datos:
str(datos)## Classes 'data.table' and 'data.frame': 1646 obs. of 11 variables:
## $ TIPO_VIVIENDA : chr "Propiedad hipotecada" "Alquiler" "Alquiler" "Propiedad hipotecada" ...
## $ VALOR_VIVIENDA: int 150000 0 0 150000 39000 0 16994 170000 36000 150000 ...
## $ PATRIMONIO : int 0 0 0 0 0 0 72575 0 30000 0 ...
## $ NACIONALIDAD : chr "Español" "Español" "Extranjero" "Español" ...
## $ IMPORTE : int 9000 2000 11000 12000 6000 10000 4800 16500 20000 15000 ...
## $ CUOTA : int 174 62 213 202 117 193 94 270 317 290 ...
## $ INGRESOS : int 18992 25500 14184 8000 NA 11200 31431 19069 12489 NA ...
## $ SALDO : int 820 0 32369 97 558 17902 2339 1075 875 448 ...
## $ EDAD : int 42 51 46 30 36 30 36 50 40 33 ...
## $ ESTADO_CIVIL : chr "Soltero" "Soltero" "Casado" "Casado" ...
## $ CLASE : chr "SI" "NO" "SI" "SI" ...
## - attr(*, ".internal.selfref")=<externalptr>
Buscamos entradas duplicadas y vemos que no hay ninguna.
anyDuplicated(datos)## [1] 0
Convertimos las variables de tipo carácter a factores.
datos$TIPO_VIVIENDA = as.factor(datos$TIPO_VIVIENDA)
datos$NACIONALIDAD = as.factor(datos$NACIONALIDAD)
datos$ ESTADO_CIVIL = as.factor(datos$ ESTADO_CIVIL)
datos$CLASE = as.factor(datos$CLASE)Vemos las primeras filas:
head(datos)## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE CUOTA
## 1: Propiedad hipotecada 150000 0 Español 9000 174
## 2: Alquiler 0 0 Español 2000 62
## 3: Alquiler 0 0 Extranjero 11000 213
## 4: Propiedad hipotecada 150000 0 Español 12000 202
## 5: Propiedad hipotecada 39000 0 Español 6000 117
## 6: Vive con la familia 0 0 Español 10000 193
## INGRESOS SALDO EDAD ESTADO_CIVIL CLASE
## 1: 18992 820 42 Soltero SI
## 2: 25500 0 51 Soltero NO
## 3: 14184 32369 46 Casado SI
## 4: 8000 97 30 Casado SI
## 5: NA 558 36 Casado SI
## 6: 11200 17902 30 Soltero SI
str(datos)## Classes 'data.table' and 'data.frame': 1646 obs. of 11 variables:
## $ TIPO_VIVIENDA : Factor w/ 5 levels "Alquiler","Otros",..: 3 1 1 3 3 5 3 3 4 3 ...
## $ VALOR_VIVIENDA: int 150000 0 0 150000 39000 0 16994 170000 36000 150000 ...
## $ PATRIMONIO : int 0 0 0 0 0 0 72575 0 30000 0 ...
## $ NACIONALIDAD : Factor w/ 2 levels "Español","Extranjero": 1 1 2 1 1 1 1 1 1 1 ...
## $ IMPORTE : int 9000 2000 11000 12000 6000 10000 4800 16500 20000 15000 ...
## $ CUOTA : int 174 62 213 202 117 193 94 270 317 290 ...
## $ INGRESOS : int 18992 25500 14184 8000 NA 11200 31431 19069 12489 NA ...
## $ SALDO : int 820 0 32369 97 558 17902 2339 1075 875 448 ...
## $ EDAD : int 42 51 46 30 36 30 36 50 40 33 ...
## $ ESTADO_CIVIL : Factor w/ 3 levels "Casado","Separado",..: 3 3 1 1 1 3 1 1 1 1 ...
## $ CLASE : Factor w/ 2 levels "NO","SI": 2 1 2 2 2 2 2 2 2 2 ...
## - attr(*, ".internal.selfref")=<externalptr>
Resumen estadístico
Comenzamos con el comando summary(), que nos da las magnitudes básicas de cada variable.
summary(datos)## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO
## Alquiler :200 Min. : 0 Min. : 0
## Otros : 77 1st Qu.: 0 1st Qu.: 0
## Propiedad hipotecada:590 Median : 75000 Median : 0
## Propiedad libre :463 Mean : 94553 Mean : 9731
## Vive con la familia :316 3rd Qu.: 150000 3rd Qu.: 0
## Max. :1280000 Max. :629214
##
## NACIONALIDAD IMPORTE CUOTA INGRESOS
## Español :1409 Min. : 285 Min. : 11.0 Min. : 0
## Extranjero: 237 1st Qu.: 4000 1st Qu.: 101.0 1st Qu.: 12600
## Median : 9000 Median : 193.0 Median : 16514
## Mean : 8655 Mean : 197.2 Mean : 19048
## 3rd Qu.:11475 3rd Qu.: 250.0 3rd Qu.: 23443
## Max. :70000 Max. :2114.0 Max. :105978
## NA's :84
## SALDO EDAD ESTADO_CIVIL CLASE
## Min. : -920.0 Min. :20.00 Casado :852 NO: 164
## 1st Qu.: 73.2 1st Qu.:34.00 Separado: 91 SI:1482
## Median : 845.0 Median :44.00 Soltero :703
## Mean : 4676.8 Mean :43.95
## 3rd Qu.: 3826.0 3rd Qu.:53.00
## Max. :339116.0 Max. :90.00
## NA's :62
Utilizamos el comando skim(), obtenemos más información útil, como el número de valores que faltan, los valores únicos en el caso de las variables cualitativas, los valores medios y la desviación típica en el caso de las variables numéricas.
skim(datos)| Name | datos |
| Number of rows | 1646 |
| Number of columns | 11 |
| Key | NULL |
| _______________________ | |
| Column type frequency: | |
| factor | 4 |
| numeric | 7 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| TIPO_VIVIENDA | 0 | 1 | FALSE | 5 | Pro: 590, Pro: 463, Viv: 316, Alq: 200 |
| NACIONALIDAD | 0 | 1 | FALSE | 2 | Esp: 1409, Ext: 237 |
| ESTADO_CIVIL | 0 | 1 | FALSE | 3 | Cas: 852, Sol: 703, Sep: 91 |
| CLASE | 0 | 1 | FALSE | 2 | SI: 1482, NO: 164 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| VALOR_VIVIENDA | 0 | 1.00 | 94552.79 | 108894.54 | 0 | 0.00 | 75000.0 | 150000 | 1280000 | ▇▁▁▁▁ |
| PATRIMONIO | 0 | 1.00 | 9730.86 | 40940.13 | 0 | 0.00 | 0.0 | 0 | 629214 | ▇▁▁▁▁ |
| IMPORTE | 0 | 1.00 | 8654.51 | 6661.21 | 285 | 4000.00 | 9000.0 | 11475 | 70000 | ▇▂▁▁▁ |
| CUOTA | 0 | 1.00 | 197.18 | 126.82 | 11 | 101.00 | 193.0 | 250 | 2114 | ▇▁▁▁▁ |
| INGRESOS | 84 | 0.95 | 19047.69 | 11325.72 | 0 | 12600.00 | 16513.5 | 23443 | 105978 | ▇▃▁▁▁ |
| SALDO | 0 | 1.00 | 4676.85 | 14228.30 | -920 | 73.25 | 845.0 | 3826 | 339116 | ▇▁▁▁▁ |
| EDAD | 62 | 0.96 | 43.95 | 12.27 | 20 | 34.00 | 44.0 | 53 | 90 | ▆▇▆▁▁ |
La función skim() nos ha mostrado que faltan algunos valores en nuestro conjunto de datos. Veámoslos con algunos métodos más.
colSums(is.na(datos))## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE
## 0 0 0 0 0
## CUOTA INGRESOS SALDO EDAD ESTADO_CIVIL
## 0 84 0 62 0
## CLASE
## 0
sapply(datos, function(x) sum(is.na(x)))## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE
## 0 0 0 0 0
## CUOTA INGRESOS SALDO EDAD ESTADO_CIVIL
## 0 84 0 62 0
## CLASE
## 0
sum(is.na(datos))## [1] 146
Hemos visto algunos detalles estadísticos utilizando summary() y skim(). Ahora usando la librería funmodeling, usaremos algunas funciones más para obtener detalles similares.
status(datos)## variable q_zeros p_zeros q_na p_na q_inf p_inf
## TIPO_VIVIENDA TIPO_VIVIENDA 0 0.000000000 0 0.00000000 0 0
## VALOR_VIVIENDA VALOR_VIVIENDA 568 0.345078979 0 0.00000000 0 0
## PATRIMONIO PATRIMONIO 1365 0.829283111 0 0.00000000 0 0
## NACIONALIDAD NACIONALIDAD 0 0.000000000 0 0.00000000 0 0
## IMPORTE IMPORTE 0 0.000000000 0 0.00000000 0 0
## CUOTA CUOTA 0 0.000000000 0 0.00000000 0 0
## INGRESOS INGRESOS 12 0.007290401 84 0.05103281 0 0
## SALDO SALDO 286 0.173754557 0 0.00000000 0 0
## EDAD EDAD 0 0.000000000 62 0.03766707 0 0
## ESTADO_CIVIL ESTADO_CIVIL 0 0.000000000 0 0.00000000 0 0
## CLASE CLASE 0 0.000000000 0 0.00000000 0 0
## type unique
## TIPO_VIVIENDA factor 5
## VALOR_VIVIENDA integer 352
## PATRIMONIO integer 102
## NACIONALIDAD factor 2
## IMPORTE integer 303
## CUOTA integer 405
## INGRESOS integer 1271
## SALDO integer 1189
## EDAD integer 62
## ESTADO_CIVIL factor 3
## CLASE factor 2
Utilizando el comando profiling_num(), obtenemos las estadísticas anteriores, pero además de eso obtenemos algunos detalles más, como el rango,inter-quartile range,skewness y kurtosis.
profiling_num(datos)## variable mean std_dev variation_coef p_01 p_05
## 1 VALOR_VIVIENDA 94552.78554 108894.53907 1.1516799 0.00 0.00
## 2 PATRIMONIO 9730.86270 40940.12904 4.2072456 0.00 0.00
## 3 IMPORTE 8654.50729 6661.21080 0.7696811 610.35 825.50
## 4 CUOTA 197.17558 126.82067 0.6431865 18.00 29.25
## 5 INGRESOS 19047.68758 11325.71673 0.5945980 127.47 5076.05
## 6 SALDO 4676.84872 14228.30237 3.0422841 -123.65 0.00
## 7 EDAD 43.94823 12.27089 0.2792123 21.00 25.00
## p_25 p_50 p_75 p_95 p_99 skewness kurtosis iqr
## 1 0.00 75000.0 150000 294500.00 420389.40 2.351692 16.837267 150000.00
## 2 0.00 0.0 0 52500.00 200000.00 7.510370 76.539677 0.00
## 3 4000.00 9000.0 11475 21000.00 30000.00 1.656710 9.278657 7475.00
## 4 101.00 193.0 250 401.00 568.40 2.715092 34.838294 149.00
## 5 12600.00 16513.5 23443 39995.00 59652.99 1.947351 10.047700 10843.00
## 6 73.25 845.0 3826 19850.25 57590.90 11.142248 207.996333 3752.75
## 7 34.00 44.0 53 64.00 73.00 0.262961 2.506213 19.00
## range_98 range_80
## 1 [0, 420389.4] [0, 240000]
## 2 [0, 2e+05] [0, 18000]
## 3 [610.35, 30000] [1161.5, 18000]
## 4 [18, 568.4] [44, 341]
## 5 [127.47, 59652.99] [8005.7, 32129.3]
## 6 [-123.65, 57590.9] [0, 11330]
## 7 [21, 73] [29, 60]
La función plot_num() nos permite visualizar histogramas de variables numéricas.
plot_num(datos)## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the funModeling package.
## Please report the issue at <https://github.com/pablo14/funModeling/issues>.
Visualización de variables categóricas por frecuencia:
freq(datos)## TIPO_VIVIENDA frequency percentage cumulative_perc
## 1 Propiedad hipotecada 590 35.84 35.84
## 2 Propiedad libre 463 28.13 63.97
## 3 Vive con la familia 316 19.20 83.17
## 4 Alquiler 200 12.15 95.32
## 5 Otros 77 4.68 100.00
## NACIONALIDAD frequency percentage cumulative_perc
## 1 Español 1409 85.6 85.6
## 2 Extranjero 237 14.4 100.0
## ESTADO_CIVIL frequency percentage cumulative_perc
## 1 Casado 852 51.76 51.76
## 2 Soltero 703 42.71 94.47
## 3 Separado 91 5.53 100.00
## CLASE frequency percentage cumulative_perc
## 1 SI 1482 90.04 90.04
## 2 NO 164 9.96 100.00
## [1] "Variables processed: TIPO_VIVIENDA, NACIONALIDAD, ESTADO_CIVIL, CLASE"
Aquí vemos gráficos de caja de diferentes variables.
plotar(datos, target= "CLASE", plot_type="boxplot")## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## ℹ The deprecated feature was likely used in the funModeling package.
## Please report the issue at <https://github.com/pablo14/funModeling/issues>.
## Warning: Removed 84 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 84 rows containing non-finite values (`stat_summary()`).
## Warning: Removed 62 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 62 rows containing non-finite values (`stat_summary()`).
Hemos visto los tipos de variables y hemos comprobado si hay filas duplicadas y, si hay NAs en nuestro conjunto de datos.Hemos visto los valores únicos en cada columna, la media y el rango en el caso de variables numéricas.También, hemos visto las ocurrencias de cada factor en la tabla de frecuencias y finalmente, hemos visto los gráficos de caja de cada variable por su CLASE.
Ahora veremos algunos estadísticos de variables categóricas y cómo se comportan con la variable de clase CLASE.
categoricas <- datos %>% select (TIPO_VIVIENDA,NACIONALIDAD,ESTADO_CIVIL,CLASE)
categ_analysis(categoricas, target = 'CLASE')## Warning: `summarise_()` was deprecated in dplyr 0.7.0.
## ℹ Please use `summarise()` instead.
## ℹ The deprecated feature was likely used in the funModeling package.
## Please report the issue at <https://github.com/pablo14/funModeling/issues>.
## Warning: `group_by_()` was deprecated in dplyr 0.7.0.
## ℹ Please use `group_by()` instead.
## ℹ See vignette('programming') for more help
## ℹ The deprecated feature was likely used in the funModeling package.
## Please report the issue at <https://github.com/pablo14/funModeling/issues>.
## TIPO_VIVIENDA mean_target sum_target perc_target q_rows perc_rows
## 1 Alquiler 0.360 72 0.439 200 0.122
## 2 Otros 0.208 16 0.098 77 0.047
## 3 Vive con la familia 0.133 42 0.256 316 0.192
## 4 Propiedad hipotecada 0.047 28 0.171 590 0.358
## 5 Propiedad libre 0.013 6 0.037 463 0.281
##
## NACIONALIDAD mean_target sum_target perc_target q_rows perc_rows
## 1 Extranjero 0.384 91 0.555 237 0.144
## 2 Español 0.052 73 0.445 1409 0.856
##
## ESTADO_CIVIL mean_target sum_target perc_target q_rows perc_rows
## 1 Separado 0.165 15 0.091 91 0.055
## 2 Soltero 0.159 112 0.683 703 0.427
## 3 Casado 0.043 37 0.226 852 0.518
## [1] "Variables processed: TIPO_VIVIENDA, NACIONALIDAD, ESTADO_CIVIL"
cross_plot(categoricas, target = 'CLASE', auto_binning = TRUE )Ahora vamos a ver cómo se comportan las variables entre sí y con nuestra variable objetivo “CLASE”. También intentaremos averiguar qué variables explican la variable CLASE mucho mejor que otras.
Tablas de correspondencias y gráficos
#creamos un conjunto de datos con sólo variables numéricas y sin NAs.
datos_num = subset(na.omit(datos), select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD"))Creación de una matriz de correlaciones:
corr_datos_num = as.data.frame((cor(datos_num)))
round(corr_datos_num,2)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS SALDO EDAD
## VALOR_VIVIENDA 1.00 0.18 0.11 0.12 0.32 0.12 0.37
## PATRIMONIO 0.18 1.00 0.11 0.11 0.07 0.03 0.16
## IMPORTE 0.11 0.11 1.00 0.91 0.10 0.02 0.06
## CUOTA 0.12 0.11 0.91 1.00 0.14 0.04 0.10
## INGRESOS 0.32 0.07 0.10 0.14 1.00 0.22 0.18
## SALDO 0.12 0.03 0.02 0.04 0.22 1.00 0.12
## EDAD 0.37 0.16 0.06 0.10 0.18 0.12 1.00
Mejores formas de visualizar las correlaciones:
correlaciones <- round(cor(datos_num), 1)
corrplot(correlaciones, method="number", type="upper")chart.Correlation(datos_num, histogram = F, pch=19)## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
Los valores de la tabla representan el grado de correlación entre pares de variables. Los valores van de -1 a 1, donde -1 representa una correlación negativa perfecta, 0 representa ninguna correlación y 1 representa una correlación positiva perfecta. Esta tabla nos da la correlación entre cada par de variables, con el tamaño de letra en función del grado de correlación, así como un conjunto de 0 a 3 estrellas, que indica la importancia de la correlación, de menor a mayor.
Observando la tabla, podemos ver que IMPORTE y CUOTA están fuertemente correlacionados positivamente, con un coeficiente de correlación de 0,91. El coeficiente de correlación entre “VALOR_VIVIENDA” y “EDAD” es de 0,37, lo que indica una correlación positiva entre estas dos variables, al igual que la correlación de 0,32 entre “VALOR_VIVIENDA” e “INGRESOS”. Ninguna de las variables tiene una correlación negativa entre sí y la mayoría de ellas tienen una correlación positiva y significativa.
Otra forma de ver las correlaciones es utilizando la función plot_correlation. Cuanto más oscuro sea el color, más correlacionadas estarán las variables.
plot_correlation(datos_num)Calculamos el nivel de significación de las diferentes correlaciones (p-value):
correlacion_pvalue = cor.mtest(datos_num, conf.level=0.95)$p
rownames(correlacion_pvalue) = rownames(correlacion_pvalue)
colnames(correlacion_pvalue) = colnames(correlacion_pvalue)La matriz resultante muestra los valores p de las correlaciones entre las variables numéricas. Los valores de la diagonal son todos 0, ya que la correlación entre una variable consigo misma es siempre 1. Los demás valores de la matriz representan los valores p de las correlaciones entre pares de variables. Por ejemplo, el valor p de la correlación entre VALOR_VIVIENDA y PATRIMONIO es 0, lo que indica una correlación significativa al nivel de significación de 0,05. Del mismo modo, el valor p de la correlación entre VALOR_VIVIENDA e IMPORTE es 0, lo que indica una correlación significativa al nivel de significación 0,05. El valor p de la correlación entre SALDO y PATRIMONIO es 0,3203, lo que indica una correlación no significativa al nivel de significación de 0,05.
# si p-value < 0,05 el valor es significativo
round(correlacion_pvalue,4)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS SALDO EDAD
## VALOR_VIVIENDA 0 0.0000 0.0000 0.0000 0.0000 0.0000 0e+00
## PATRIMONIO 0 0.0000 0.0000 0.0000 0.0069 0.3203 0e+00
## IMPORTE 0 0.0000 0.0000 0.0000 0.0000 0.5459 2e-02
## CUOTA 0 0.0000 0.0000 0.0000 0.0000 0.1521 2e-04
## INGRESOS 0 0.0069 0.0000 0.0000 0.0000 0.0000 0e+00
## SALDO 0 0.3203 0.5459 0.1521 0.0000 0.0000 0e+00
## EDAD 0 0.0000 0.0200 0.0002 0.0000 0.0000 0e+00
Utilizaremos la librería inspectdb para generar los coeficientes de correlación de Pearson, el p-value y los intervalos de confianza.
La tabla siguiente muestra las correlaciones entre pares de variables utilizando datos_num. También muestra los valores p, los límites inferior y superior del intervalo de confianza y el porcentaje de valores no ausentes para cada correlación.
La correlación positiva más fuerte es la existente entre CUOTA e IMPORTE, con un coeficiente de correlación de 0,91.
Hay varias correlaciones con valores p inferiores a 0,05, lo que indica una correlación estadísticamente significativa.
x <- inspect_cor(datos_num)
x1 <- as.data.frame(x)
paged_table(x1)Aquí puede verse una buena visualización de los coeficientes de correlación por pares.
show_plot(x)Ahora vamos a observar algunas tablas de datos y centrar nuestro análisis en variables categóricas, que nos ayuden a comprender si existe alguna asociación o patrón entre nuestras variables a la hora de explicar nuestra variable objetivo CLASE.
table(datos$CLASE)##
## NO SI
## 164 1482
round(prop.table(table(datos$CLASE)),2)##
## NO SI
## 0.1 0.9
Contraste tabla de contingencia.
Creamos una tabla de contingencia de TIPO_VIVIENDA y CLASE. El resultado muestra que el estadístico chi-cuadrado de Pearson es 221,76 con 4 grados de libertad y un p valor inferior a 2,2e-16. Esto indica que existe una asociación significativa entre TIPO_VIVIENDA y CLASE.
t1 <- table(datos$TIPO_VIVIENDA,datos$CLASE)
addmargins(t1)##
## NO SI Sum
## Alquiler 72 128 200
## Otros 16 61 77
## Propiedad hipotecada 28 562 590
## Propiedad libre 6 457 463
## Vive con la familia 42 274 316
## Sum 164 1482 1646
chisq.test(t1)##
## Pearson's Chi-squared test
##
## data: t1
## X-squared = 221.76, df = 4, p-value < 2.2e-16
La siguiente tabla es entre las variables NACIONALIDAD y CLASE. Aquí utilizaremos CrossTable() de la librería gmodels en formato SPSS para una mejor visualización de los resultados. Como podemos ver, el valor p es muy pequeño proporcionando una fuerte evidencia contra la hipótesis nula de independencia entre las dos variables.
t2 <- table(datos$NACIONALIDAD,datos$CLASE)
addmargins(t2)##
## NO SI Sum
## Español 73 1336 1409
## Extranjero 91 146 237
## Sum 164 1482 1646
CrossTable(t2, expected = TRUE, format="SPSS")##
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Chi-square contribution |
## | Row Percent |
## | Column Percent |
## | Total Percent |
## |-------------------------|
##
## Total Observations in Table: 1646
##
## |
## | NO | SI | Row Total |
## -------------|-----------|-----------|-----------|
## Español | 73 | 1336 | 1409 |
## | 140.386 | 1268.614 | |
## | 32.346 | 3.579 | |
## | 5.181% | 94.819% | 85.601% |
## | 44.512% | 90.148% | |
## | 4.435% | 81.166% | |
## -------------|-----------|-----------|-----------|
## Extranjero | 91 | 146 | 237 |
## | 23.614 | 213.386 | |
## | 192.301 | 21.280 | |
## | 38.397% | 61.603% | 14.399% |
## | 55.488% | 9.852% | |
## | 5.529% | 8.870% | |
## -------------|-----------|-----------|-----------|
## Column Total | 164 | 1482 | 1646 |
## | 9.964% | 90.036% | |
## -------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 249.5069 d.f. = 1 p = 3.326196e-56
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 245.818 d.f. = 1 p = 2.119287e-55
##
##
## Minimum expected frequency: 23.61361
Ahora observamos la variable ESTADO_CIVIL con CLASE. Aquí también el valor p es muy inferior a 0,05, lo que sugiere una fuerte asociación entre las dos variables.
t3 <- table(datos$ESTADO_CIVIL,datos$CLASE)
addmargins(t3)##
## NO SI Sum
## Casado 37 815 852
## Separado 15 76 91
## Soltero 112 591 703
## Sum 164 1482 1646
CrossTable(t3, expected = TRUE, format="SPSS")##
## Cell Contents
## |-------------------------|
## | Count |
## | Expected Values |
## | Chi-square contribution |
## | Row Percent |
## | Column Percent |
## | Total Percent |
## |-------------------------|
##
## Total Observations in Table: 1646
##
## |
## | NO | SI | Row Total |
## -------------|-----------|-----------|-----------|
## Casado | 37 | 815 | 852 |
## | 84.889 | 767.111 | |
## | 27.016 | 2.990 | |
## | 4.343% | 95.657% | 51.762% |
## | 22.561% | 54.993% | |
## | 2.248% | 49.514% | |
## -------------|-----------|-----------|-----------|
## Separado | 15 | 76 | 91 |
## | 9.067 | 81.933 | |
## | 3.883 | 0.430 | |
## | 16.484% | 83.516% | 5.529% |
## | 9.146% | 5.128% | |
## | 0.911% | 4.617% | |
## -------------|-----------|-----------|-----------|
## Soltero | 112 | 591 | 703 |
## | 70.044 | 632.956 | |
## | 25.132 | 2.781 | |
## | 15.932% | 84.068% | 42.710% |
## | 68.293% | 39.879% | |
## | 6.804% | 35.905% | |
## -------------|-----------|-----------|-----------|
## Column Total | 164 | 1482 | 1646 |
## | 9.964% | 90.036% | |
## -------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 62.23111 d.f. = 2 p = 3.066806e-14
##
##
##
## Minimum expected frequency: 9.066829
Ahora utilizaremos variables cuantitativas en nuestro análisis para crear diferentes tablas por CLASE y obtener una buena visión de algunos números.
table1 <- datos %>%
group_by(CLASE) %>%
summarize(VALOR_VIVIENDA_Media = mean(VALOR_VIVIENDA, na.rm = TRUE),
PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
CUOTA_Media = mean(CUOTA, na.rm = TRUE),
INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
SALDO_Media = mean(SALDO, na.rm = TRUE),
EDAD_Media = mean(EDAD, na.rm = TRUE)) %>%
mutate(CLASE = factor(CLASE, levels = c("SI", "NO")))
# dar formato a la tabla utilizando flextable
table1 = flextable(table1) %>%
colformat_double(big.mark = ".",decimal.mark = ",",digits =2)%>%
add_header_lines(values = "Valor de la media en función del tipo de cliente*")%>%
add_footer_lines(values = "Tipo de cliente ='SI',pagaron el crédito., 'NO',no pagaron el crédito")%>%
color(color = "#993399", part = "header")%>%
color(color = "chocolate4", part = "body")%>%
color(color = "grey", part = "footer")%>%
autofit()%>%
align(align = "center", part = "all")
table1Valor de la media en función del tipo de cliente* | |||||||
|---|---|---|---|---|---|---|---|
CLASE | VALOR_VIVIENDA_Media | PATRIMONIO_Media | IMPORTE_Media | CUOTA_Media | INGRESOS_Media | SALDO_Media | EDAD_Media |
NO | 22.700,23 | 2.128,70 | 5.685,05 | 173,41 | 15.991,15 | 592,74 | 38,59 |
SI | 102.504,08 | 10.572,13 | 8.983,11 | 199,80 | 19.374,79 | 5.128,80 | 44,55 |
Tipo de cliente ='SI',pagaron el crédito., 'NO',no pagaron el crédito | |||||||
table2 <- datos %>%
group_by(TIPO_VIVIENDA, CLASE) %>%
summarise(mean_VALOR_VIVIENDA = mean(VALOR_VIVIENDA, na.rm = TRUE),
PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
CUOTA_Media = mean(CUOTA, na.rm = TRUE),
INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
SALDO_Media = mean(SALDO, na.rm = TRUE),
EDAD_Media = mean(EDAD, na.rm = TRUE))## `summarise()` has grouped output by 'TIPO_VIVIENDA'. You can override using the
## `.groups` argument.
# dar formato a la tabla utilizando kablextra
kable_styling(kable(table2,
format ="html",
digits = c(NA,NA,2,2,2,2,2,2,2),
format.args = list(decimal.mark = ",", big.mark = "."),
row.names = F,
align = c("l","c","c","c","c"),
booktabs = T,
caption = "Tabla de TIPO_VIVIENDA con CLASE",
latex_options = c("striped","condensed"),
position = "center",
full_width = F))| TIPO_VIVIENDA | CLASE | mean_VALOR_VIVIENDA | PATRIMONIO_Media | IMPORTE_Media | CUOTA_Media | INGRESOS_Media | SALDO_Media | EDAD_Media |
|---|---|---|---|---|---|---|---|---|
| Alquiler | NO | 1.083,33 | 55,56 | 5.345,93 | 173,42 | 16.127,76 | 513,69 | 39,82 |
| Alquiler | SI | 2.226,56 | 515,62 | 8.171,48 | 181,00 | 15.419,06 | 3.056,65 | 40,81 |
| Otros | NO | 5.624,69 | 937,50 | 5.215,62 | 164,62 | 13.855,15 | 201,88 | 35,56 |
| Otros | SI | 5.520,98 | 6.674,75 | 9.500,00 | 206,13 | 16.202,44 | 4.967,33 | 43,08 |
| Propiedad hipotecada | NO | 96.851,50 | 8.575,21 | 7.778,14 | 172,96 | 17.154,12 | 330,50 | 38,81 |
| Propiedad hipotecada | SI | 133.454,90 | 9.119,39 | 8.951,35 | 193,57 | 20.950,17 | 3.798,88 | 43,44 |
| Propiedad libre | NO | 110.000,00 | 5.833,33 | 6.733,17 | 231,17 | 24.884,83 | 2.022,33 | 55,00 |
| Propiedad libre | SI | 163.634,56 | 19.430,14 | 9.559,43 | 220,51 | 21.138,80 | 8.153,91 | 54,48 |
| Vive con la familia | NO | 4.357,14 | 1.309,52 | 4.900,12 | 168,81 | 14.351,21 | 847,76 | 35,02 |
| Vive con la familia | SI | 5.498,62 | 4.343,30 | 8.351,11 | 185,44 | 15.909,57 | 3.815,04 | 32,67 |
table3 <- datos %>%
group_by(NACIONALIDAD, CLASE) %>%
summarise(mean_VALOR_VIVIENDA = mean(VALOR_VIVIENDA, na.rm = TRUE),
PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
CUOTA_Media = mean(CUOTA, na.rm = TRUE),
INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
SALDO_Media = mean(SALDO, na.rm = TRUE),
EDAD_Media = mean(EDAD, na.rm = TRUE))## `summarise()` has grouped output by 'NACIONALIDAD'. You can override using the
## `.groups` argument.
kable_styling(kable(table3,
format ="html",
digits = c(NA,NA,2,2,2,2,2,2,2),
format.args = list(decimal.mark = ",", big.mark = "."),
row.names = F,
align = c("l","c","c","c","c"),
booktabs = T,
caption = "Tabla de NACIONALIDAD con CLASE",
latex_options = c("striped","condensed"),
position = "center",
full_width = F))| NACIONALIDAD | CLASE | mean_VALOR_VIVIENDA | PATRIMONIO_Media | IMPORTE_Media | CUOTA_Media | INGRESOS_Media | SALDO_Media | EDAD_Media |
|---|---|---|---|---|---|---|---|---|
| Español | NO | 27.760,00 | 4.563,10 | 5.335,90 | 170,64 | 16.546,56 | 752,99 | 42,34 |
| Español | SI | 110.500,63 | 11.641,39 | 9.013,95 | 201,31 | 19.943,49 | 5.526,55 | 45,20 |
| Extranjero | NO | 18.641,29 | 175,82 | 5.965,14 | 175,64 | 15.536,12 | 464,20 | 35,68 |
| Extranjero | SI | 29.330,15 | 787,67 | 8.700,92 | 186,07 | 14.447,35 | 1.489,16 | 38,72 |
table4 <- datos %>%
group_by(ESTADO_CIVIL, CLASE) %>%
summarise(mean_VALOR_VIVIENDA = mean(VALOR_VIVIENDA, na.rm = TRUE),
PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
CUOTA_Media = mean(CUOTA, na.rm = TRUE),
INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
SALDO_Media = mean(SALDO, na.rm = TRUE),
EDAD_Media = mean(EDAD, na.rm = TRUE))## `summarise()` has grouped output by 'ESTADO_CIVIL'. You can override using the
## `.groups` argument.
kable_styling(kable(table4,
format ="html",
digits = c(NA,NA,2,2,2,2,2,2,2),
format.args = list(decimal.mark = ",", big.mark = "."),
row.names = F,
align = c("l","c","c","c","c"),
booktabs = T,
caption = "Tabla de ESTADO_CIVIL con CLASE",
latex_options = c("striped","condensed"),
position = "center",
full_width = F))| ESTADO_CIVIL | CLASE | mean_VALOR_VIVIENDA | PATRIMONIO_Media | IMPORTE_Media | CUOTA_Media | INGRESOS_Media | SALDO_Media | EDAD_Media |
|---|---|---|---|---|---|---|---|---|
| Casado | NO | 60.661,62 | 4.056,92 | 6.987,49 | 179,95 | 17.840,76 | 434,19 | 41,41 |
| Casado | SI | 127.764,66 | 14.042,34 | 9.269,86 | 207,47 | 19.637,23 | 5.634,55 | 48,37 |
| Separado | NO | 30.690,80 | 1.000,00 | 4.939,47 | 156,67 | 20.178,13 | 234,53 | 47,20 |
| Separado | SI | 112.074,12 | 12.577,78 | 8.370,78 | 181,36 | 23.742,52 | 4.191,68 | 48,92 |
| Soltero | NO | 9.089,24 | 1.642,86 | 5.354,64 | 173,50 | 14.788,81 | 693,10 | 36,44 |
| Soltero | SI | 66.438,61 | 5.528,72 | 8.666,42 | 191,60 | 18.441,11 | 4.551,87 | 38,77 |
Podemos utilizar varios métodos de representación gráfica de las variables independientes para comprender su influencia en la variable dependiente. Utilizaremos diferentes estilos como diagramas de barras, diagramas de dispersión, histogramas, diagramas de caja. Para ello, utilizaremos gráficos de la librería ggplot2 que ofrece múltiples formas para representar información gráficamente.
Definiremos una función para crear gráficos de dispersión. Lo visualizaremos según los niveles de la variable dependiente. También se añade una línea de tendencia general que muestra el intervalo de confianza.
graf_dispersion <- function(var1,var2){
dat <- datos[, c(var1, var2, "CLASE"), with = FALSE]
ggplot(data = dat, aes_string(x = var1, y = var2)) +
geom_point(aes_string(col = "CLASE")) +
geom_smooth() +
ggtitle('Gráfico Scatter Plot') +
theme(plot.title = element_text(color = "blue", hjust = 0.5)) +
labs(x = var1, y = var2)
}graf_dispersion("IMPORTE","INGRESOS")## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation ideoms with `aes()`
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
## Warning: Removed 84 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 84 rows containing missing values (`geom_point()`).
graf_dispersion("SALDO","EDAD")## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
## Warning: Removed 62 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 62 rows containing missing values (`geom_point()`).
graf_dispersion("VALOR_VIVIENDA","PATRIMONIO")## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
Algunos gráficos con histogramas:
hist1 = ggplot(datos, aes(x = IMPORTE)) +
geom_histogram(aes(y=..density..), colour="black", fill = "lightblue") +
geom_density(alpha = .2, fill = "#FF6666") +
ggtitle("Histograma IMPORTE") +
theme(plot.title = element_text(color = "black")) +
facet_grid(CLASE ~.)
hist1## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
hist1 = ggplot(datos, aes(x = INGRESOS)) +
geom_histogram(aes(y=..density..), colour="black", fill = "lightblue") +
geom_density(alpha = .2, fill = "#FF6666") +
ggtitle("Histograma INGRESOS") +
theme(plot.title = element_text(color = "black")) +
facet_grid(CLASE ~.)
hist1## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 84 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 84 rows containing non-finite values (`stat_density()`).
hist1 = ggplot(datos, aes(x = EDAD)) +
geom_histogram(aes(y=..density..), colour="black", fill = "lightblue") +
geom_density(alpha = .2, fill = "#FF6666") +
ggtitle("Histograma EDAD") +
theme(plot.title = element_text(color = "black")) +
facet_grid(CLASE ~.)
hist1## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 62 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 62 rows containing non-finite values (`stat_density()`).
Ahora utilizamos el diagrama de cajas para cada variable numérica independiente frente a la variable dependiente categórica CLASE (NO y SI) y, añadimos una comparación estadística de medias utilizando una prueba t. El gráfico muestra la distribución de la variable independiente para cada grupo y nos permite comparar las medianas, los cuartiles y el rango de los dos grupos. La comparación estadística indica si existe una diferencia significativa entre las medias de los dos grupos.
# Diagramas de cajas (con p-value para el contraste t de student)
# variable VALOR_VIVIENDA
ggplot(data = datos, aes(x = CLASE, y= VALOR_VIVIENDA)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y VALOR_VIVIENDA")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")Para entender correctamente si las varianzas de los grupos son iguales o no y para sacar conclusiones sobre la significación del gráfico anterior, realizaremos una prueba de homogeneidad de varianzas. Utilizaremos dos pruebas porque en algunos casos pueden dar valores p diferentes (aunque podemos utilizar cualquiera).
La prueba de Levene es una prueba paramétrica que comprueba si las varianzas de los grupos son iguales. Supone que los datos se distribuyen normalmente, y el estadístico de la prueba se basa en las desviaciones absolutas de los datos respecto a las medias de los grupos. Un resultado significativo (valor p < 0,05) sugiere que las varianzas son diferentes, lo que viola el supuesto de homogeneidad de la varianza.
La prueba de Fligner-Killeen es una alternativa no paramétrica a la prueba de Levene. Se basa en las medianas de las desviaciones absolutas de las medianas de grupo, lo que la hace más robusta a las desviaciones de la normalidad. Al igual que la prueba de Levene, un resultado significativo sugiere que las varianzas de los grupos son diferentes.
fligner.test(VALOR_VIVIENDA ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: VALOR_VIVIENDA by CLASE
## Fligner-Killeen:med chi-squared = 130.35, df = 1, p-value < 2.2e-16
leveneTest(VALOR_VIVIENDA ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 94.317 < 2.2e-16 ***
## 1644
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable PATRIMONIO
ggplot(data = datos, aes(x = CLASE, y= PATRIMONIO)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y PATRIMONIO")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")fligner.test(PATRIMONIO ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: PATRIMONIO by CLASE
## Fligner-Killeen:med chi-squared = 13.835, df = 1, p-value = 0.0001996
leveneTest(PATRIMONIO ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 6.3009 0.01216 *
## 1644
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable IMPORTE
ggplot(data = datos, aes(x = CLASE, y= IMPORTE)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y IMPORTE")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")fligner.test(IMPORTE ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: IMPORTE by CLASE
## Fligner-Killeen:med chi-squared = 15.622, df = 1, p-value = 7.733e-05
leveneTest(IMPORTE ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 14.762 0.0001266 ***
## 1644
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable CUOTA
ggplot(data = datos, aes(x = CLASE, y= CUOTA)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y CUOTA")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")fligner.test(CUOTA ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: CUOTA by CLASE
## Fligner-Killeen:med chi-squared = 18.218, df = 1, p-value = 1.97e-05
leveneTest(CUOTA ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 12.977 0.0003247 ***
## 1644
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable INGRESOS
ggplot(data = datos, aes(x = CLASE, y= INGRESOS)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y INGRESOS")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")## Warning: Removed 84 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 84 rows containing non-finite values (`stat_signif()`).
fligner.test(INGRESOS ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: INGRESOS by CLASE
## Fligner-Killeen:med chi-squared = 22.953, df = 1, p-value = 1.66e-06
leveneTest(INGRESOS ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 14.706 0.0001306 ***
## 1560
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable SALDO
ggplot(data = datos, aes(x = CLASE, y= SALDO)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y SALDO")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")fligner.test(SALDO ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: SALDO by CLASE
## Fligner-Killeen:med chi-squared = 156.7, df = 1, p-value < 2.2e-16
leveneTest(SALDO ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 13.783 0.0002121 ***
## 1644
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable EDAD
ggplot(data = datos, aes(x = CLASE, y= EDAD)) +
geom_boxplot(color = 'darkorchid4') +
ggtitle("Box Plot entre CLASE y EDAD")+
stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")## Warning: Removed 62 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 62 rows containing non-finite values (`stat_signif()`).
fligner.test(EDAD ~ CLASE, data = datos)##
## Fligner-Killeen test of homogeneity of variances
##
## data: EDAD by CLASE
## Fligner-Killeen:med chi-squared = 3.2641, df = 1, p-value = 0.07081
leveneTest(EDAD ~ CLASE, data = datos, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 1 2.8727 0.09029 .
## 1582
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Pasemos ahora a las variables categóricas. Utilizaremos gráficos de barras para interpretar qué niveles de la variable independiente tienen una mayor influencia en la variable dependiente. El gráfico de barras nos permite comparar visualmente la distribución de la variable dependiente entre las distintas categorías de la variable independiente e identificar posibles patrones o diferencias.
En el caso del tipo de vivienda, tener Propiedad hipotecada y Propiedad libre parece tener mucha más influencia en el pago del préstamo que otras. Vivir con la familia también tiene cierta influencia en los préstamos pagados.
ggplot(datos, aes( x = CLASE)) +
geom_bar(colour = "darkorchid4",fill = "lightblue") +
facet_grid(. ~ TIPO_VIVIENDA) +
ggtitle("Préstamo pagado o no vs tipo de vivienda")En el caso de la Nacionalidad, parece que influye más ser español que extranjero, ya que la mayoría de los españoles han devuelto sus préstamos.
ggplot(datos, aes( x = CLASE)) +
geom_bar(colour = "darkorchid4",fill = "lightblue") +
facet_grid(. ~ NACIONALIDAD) +
ggtitle("Préstamo pagado o no vs nacionalidad")En caso de estado civil, ser casado y soltero parece influir en que se pague el préstamo. Separado no tiene mucha influencia en si el préstamo se paga o no.
ggplot(datos, aes( x = CLASE)) +
geom_bar(colour = "darkorchid4",fill = "lightblue") +
facet_grid(. ~ ESTADO_CIVIL) +
ggtitle("Préstamo pagado o no vs estado civil")En nuestros análisis hasta ahora podemos decir que muchas variables han mostrado una buena asociación o influencia en la explicación de la variable dependiente. VALOR_VIVIENDA,IMPORTE,CUOTA,INGRESOS,SALDO todas ellas tienen una p-value más baja y sugieren que son significativas a la hora de explicar si el préstamo se paga o no. Por otro lado, las variables categóricas PATRIMONIO,EDAD mostraron resultados no significativos.
Considerando las variables categóricas,TIPO_VIVIENDA,NACIONALIDAD,ESTADO_CIVIL todas han mostrado alguna asociación con CLASE.
En primer lugar vamos a ver qué datos faltan de diferentes maneras.
Usando la función básica de R.
sapply(datos,
function(x) sum(is.na(x)))## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE
## 0 0 0 0 0
## CUOTA INGRESOS SALDO EDAD ESTADO_CIVIL
## 0 84 0 62 0
## CLASE
## 0
Usando plot_missing() de la librería dataExplorer
plot_missing(datos)Como podemos ver en los resultados anteriores, en nuestro conjunto de datos faltan datos. Ahora procederemos a comprobar si siguen algún patrón o mantienen la estructura y los trataremos en consecuencia.
md.pattern(datos, rotate.names = T)## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE CUOTA SALDO
## 1504 1 1 1 1 1 1 1
## 80 1 1 1 1 1 1 1
## 58 1 1 1 1 1 1 1
## 4 1 1 1 1 1 1 1
## 0 0 0 0 0 0 0
## ESTADO_CIVIL CLASE EDAD INGRESOS
## 1504 1 1 1 1 0
## 80 1 1 1 0 1
## 58 1 1 0 1 1
## 4 1 1 0 0 2
## 0 0 62 84 146
Podemos ver que faltan valores en dos variables: EDAD e INGRESOS. La tabla anterior muestra que en 1504 filas todas las variables están presentes. En 80 filas todas las variables están presentes excepto INGRESOS. De forma similar, en 58 filas sólo falta EDAD y en 4 filas faltan EDAD e INGRESOS. También podemos ver los datos ausentes utilizando la librería VIM. Aquí podemos ver el porcentaje de valores ausentes en cada variable.
aggr(datos,col = c('navyblue','red'),numbers = T,sortVars = T,labels = names(datos),
cex.axis = 0.7,gap = 3,ylab = c("hist de valores perdidos","estructura"))##
## Variables sorted by number of missings:
## Variable Count
## INGRESOS 0.05103281
## EDAD 0.03766707
## TIPO_VIVIENDA 0.00000000
## VALOR_VIVIENDA 0.00000000
## PATRIMONIO 0.00000000
## NACIONALIDAD 0.00000000
## IMPORTE 0.00000000
## CUOTA 0.00000000
## SALDO 0.00000000
## ESTADO_CIVIL 0.00000000
## CLASE 0.00000000
Después de ver los valores ausentes que tenemos en nuestro conjunto de datos, no se observa ningún patrón visible aquí.Debemos comprobar su aleatoriedad y para ello, utilizamos la librería Naniar.
mcar_test(datos)## # A tibble: 1 × 4
## statistic df p.value missing.patterns
## <dbl> <dbl> <dbl> <int>
## 1 36.4 29 0.163 4
El valor p de 0,163408 sugiere que no podemos rechazar la hipótesis nula de MCAR a un nivel de significación de 0,05, lo que significa que los datos ausentes en el conjunto de datos faltan completamente al azar.
Antes de proceder a la imputación del conjunto de datos, es una buena práctica ver los resultados antes y después de dicha imputación, por lo que registramos el valor medio de cada columna sin tener en cuenta los valores que faltan para compararlos después de la imputación.
datos_sinNA_num = na.omit(datos_num)
dim(datos_sinNA_num)## [1] 1504 7
sum(is.na(datos_sinNA_num))## [1] 0
round(apply(datos_sinNA_num, 2, mean),2)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS
## 93327.87 9758.94 8654.50 196.87 19029.13
## SALDO EDAD
## 4576.34 43.99
Imputación de los valores ausentes
Ahora podemos proceder a imputar los datos que faltan.
Para ello vamos a utilizar tres métodos diferentes:
1.Método PMM(predictive mean matching ) de la librería mice.
2.Metodo árboles CART de la librería mice.
3.Los K-vecinos, de la librería DMwR.
Utilizando el método PMM:
imputed_data_pmm = mice(datos,m=5,verbose=T) #El método pmm está por defecto en MICE##
## iter imp variable
## 1 1 INGRESOS EDAD
## 1 2 INGRESOS EDAD
## 1 3 INGRESOS EDAD
## 1 4 INGRESOS EDAD
## 1 5 INGRESOS EDAD
## 2 1 INGRESOS EDAD
## 2 2 INGRESOS EDAD
## 2 3 INGRESOS EDAD
## 2 4 INGRESOS EDAD
## 2 5 INGRESOS EDAD
## 3 1 INGRESOS EDAD
## 3 2 INGRESOS EDAD
## 3 3 INGRESOS EDAD
## 3 4 INGRESOS EDAD
## 3 5 INGRESOS EDAD
## 4 1 INGRESOS EDAD
## 4 2 INGRESOS EDAD
## 4 3 INGRESOS EDAD
## 4 4 INGRESOS EDAD
## 4 5 INGRESOS EDAD
## 5 1 INGRESOS EDAD
## 5 2 INGRESOS EDAD
## 5 3 INGRESOS EDAD
## 5 4 INGRESOS EDAD
## 5 5 INGRESOS EDAD
Comprobamos qué método se ha utilizado:
imputed_data_pmm$meth## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE
## "" "" "" "" ""
## CUOTA INGRESOS SALDO EDAD ESTADO_CIVIL
## "" "pmm" "" "pmm" ""
## CLASE
## ""
Imputación del conjunto de datos
datos_imputados_pmm = complete(imputed_data_pmm)Podemos ver que ya no faltan datos.
sapply(datos_imputados_pmm, function(x) sum(is.na(x)))## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE
## 0 0 0 0 0
## CUOTA INGRESOS SALDO EDAD ESTADO_CIVIL
## 0 0 0 0 0
## CLASE
## 0
dim(datos_imputados_pmm)## [1] 1646 11
datos_numNA_pmm= subset(datos_imputados_pmm, select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD")) #Selecting numerical variables to later compare their meansAhora comparamos las variables del conjunto de datos original -sin los NA- frente a las del conjunto completo con los datos imputados.
par(mfrow=c(1,2))
plot(density(datos$EDAD,na.rm = T),col=2,main="Variable EDAD. Método pmm")
lines(density(datos_imputados_pmm$EDAD),col=3)
plot(density(datos$INGRESOS,na.rm = T),col=2,main="Variable INGRESOS. Método pmm")
lines(density(datos_imputados_pmm$INGRESOS),col=3)Pasando a nuestro segundo método, utilizamos Metodo árboles CART de librería MICE.
imputed_data_cart <- mice(datos, meth = "cart", minbucket = 4)##
## iter imp variable
## 1 1 INGRESOS EDAD
## 1 2 INGRESOS EDAD
## 1 3 INGRESOS EDAD
## 1 4 INGRESOS EDAD
## 1 5 INGRESOS EDAD
## 2 1 INGRESOS EDAD
## 2 2 INGRESOS EDAD
## 2 3 INGRESOS EDAD
## 2 4 INGRESOS EDAD
## 2 5 INGRESOS EDAD
## 3 1 INGRESOS EDAD
## 3 2 INGRESOS EDAD
## 3 3 INGRESOS EDAD
## 3 4 INGRESOS EDAD
## 3 5 INGRESOS EDAD
## 4 1 INGRESOS EDAD
## 4 2 INGRESOS EDAD
## 4 3 INGRESOS EDAD
## 4 4 INGRESOS EDAD
## 4 5 INGRESOS EDAD
## 5 1 INGRESOS EDAD
## 5 2 INGRESOS EDAD
## 5 3 INGRESOS EDAD
## 5 4 INGRESOS EDAD
## 5 5 INGRESOS EDAD
datos_imputados_cart = complete(imputed_data_cart)
datos_numNA_cart= subset(datos_imputados_cart, select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD"))par(mfrow=c(1,2))
plot(density(datos$EDAD,na.rm = T),col=2,main="Variable EDAD. Método CART")
lines(density(datos_imputados_cart$EDAD),col=3)
plot(density(datos$INGRESOS,na.rm = T),col=2,main="Variable INGRESOS. Método CART")
lines(density(datos_imputados_cart$INGRESOS),col=3)Nuestro tercer enfoque es a través de los K-vecinos, de la librería DMwR.
datos_imputados_knn = knnImputation(datos)
datos_numNA_knn= subset(datos_imputados_knn, select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD"))
# Comprobamos que ya no existen valores ausentes
sapply(datos_imputados_knn, function(x) sum(is.na(x)))## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE
## 0 0 0 0 0
## CUOTA INGRESOS SALDO EDAD ESTADO_CIVIL
## 0 0 0 0 0
## CLASE
## 0
par(mfrow=c(1,2))
plot(density(datos$EDAD,na.rm = T),col=2,main="Variable EDAD. Método knn")
lines(density(datos_imputados_knn$EDAD),col=3)
plot(density(datos$INGRESOS,na.rm = T),col=2,main="Variable INGRESOS. Método knn")
lines(density(datos_imputados_knn$INGRESOS),col=3)Observando las representaciones gráficas anteriores, no podemos concluir qué método da mejores resultados, ya que todos ellos captan bien los patrones subyacentes y la variabilidad de los datos. Procedamos a comparar las medias de cada variable de todos los métodos que hemos utilizado y también con los datos originales sin considerar sus valores ausentes.
print("Medias de las variables numéricas originales")## [1] "Medias de las variables numéricas originales"
round(apply(datos_sinNA_num, 2, mean, na.rm=TRUE),2)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS
## 93327.87 9758.94 8654.50 196.87 19029.13
## SALDO EDAD
## 4576.34 43.99
print("Medias de las variables numéricas. Método PMM")## [1] "Medias de las variables numéricas. Método PMM"
round(apply(datos_numNA_pmm, 2, mean),2)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS
## 94552.79 9730.86 8654.51 197.18 19004.57
## SALDO EDAD
## 4676.85 44.05
print("Medias de las variables numéricas. Árbol CART")## [1] "Medias de las variables numéricas. Árbol CART"
round(apply(datos_numNA_cart, 2, mean),2)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS
## 94552.79 9730.86 8654.51 197.18 18979.31
## SALDO EDAD
## 4676.85 43.95
print("Medias de las variables numéricas. Método K-Vecinos")## [1] "Medias de las variables numéricas. Método K-Vecinos"
round(apply(datos_numNA_knn, 2, mean),2)## VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS
## 94552.79 9730.86 8654.51 197.18 19064.20
## SALDO EDAD
## 4676.85 43.97
Si se comparan las medias de los datos originales y de los datos imputados por los tres métodos diferentes, se observa que las medias de los datos imputados por los tres métodos se aproximan mucho a las medias de los datos originales. Sin embargo, las medias de los datos imputados por el método k-vecinos están ligeramente más cerca de las medias de los datos originales que las de los otros dos métodos.
Por lo tanto, basándonos en las medias de los datos imputados, podemos concluir que el método de imputación K-NN puede utilizarse para imputar valores ausentes en el conjunto de datos dado.
Los valores atípicos suelen identificarse como observaciones que se alejan del resto de los puntos de datos. Para encontrar valores atípicos en nuestro conjunto de datos existen muchos métodos. En nuestro caso, ninguno de los niveles de las variables categóricas tiene una proporción demasiado baja en los datos, por lo que consideraremos variables numéricas imputadas con el método k-vecinos.
par(mfrow=c(2,4))
boxplot(datos_numNA_knn$VALOR_VIVIENDA)
boxplot(datos_numNA_knn$PATRIMONIO)
boxplot(datos_numNA_knn$IMPORTE)
boxplot(datos_numNA_knn$CUOTA)
boxplot(datos_numNA_knn$INGRESOS)
boxplot(datos_numNA_knn$SALDO)
boxplot(datos_numNA_knn$EDAD)Usamos las funciones diagnose_outlier y plot_outlier de la librería dlookr. Esto nos da una información muy buena y detallada acerca de los valores atípicos.Esto también muestra el cambio en los datos con y sin valores atípicos simultáneamente.
variables <- c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD")
datos_imputados_knn %>% diagnose_outlier(variables)## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
## # Was:
## data %>% select(variables)
##
## # Now:
## data %>% select(all_of(variables))
##
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## variables outliers_cnt outliers_ratio outliers_mean
## VALOR_VIVIENDA VALOR_VIVIENDA 24 1.4580802 554625.3333
## PATRIMONIO PATRIMONIO 281 17.0716889 57000.0000
## IMPORTE IMPORTE 65 3.9489672 28592.8462
## CUOTA CUOTA 43 2.6123937 595.4419
## INGRESOS INGRESOS 81 4.9210207 52543.0864
## SALDO SALDO 197 11.9684083 28000.8782
## EDAD EDAD 2 0.1215067 86.0000
## with_mean without_mean
## VALOR_VIVIENDA 94552.78554 87745.3002
## PATRIMONIO 9730.86270 0.0000
## IMPORTE 8654.50729 7834.7780
## CUOTA 197.17558 186.4922
## INGRESOS 19064.20204 17331.4291
## SALDO 4676.84872 1505.8109
## EDAD 43.97473 43.9236
datos_imputados_knn %>% plot_outlier()datos_imputados_knn %>% target_by(CLASE) %>% plot_outlier(variables)Dado que el tema del tratamiento de los valores atípicos es muy delicado,depende de nuestro objetivo de análisis y también de cómo se haya mantenido el conjunto de datos, debemos ser conscientes de no modificar demasiado el conjunto de datos.En la práctica, preprocesar los datos tratando los valores atípicos tiende a producir resultados más precisos en presencia de datos no vistos. En nuestro caso, utilizaremos dos métodos para tratar los valores atípicos.
1.Método Tukey: Este método marca los valores atípicos teniendo en cuenta los valores de los cuartiles, Q1, Q2 y Q3, donde Q1 equivale al percentil 25, Q2 al percentil 50 (también conocido como mediana) y Q3 es el percentil 75. Estamos utilizando type=‘stop’ ya que esto convertirá los valores fuera del umbral en umbral. Si tuviéramos que convertirlos en ‘NA’, habríamos utilizado type=“set_na”, pero como ya hemos tratado los valores que faltan y además necesitamos este modelo para la modelización predictiva, sustituiremos los valores atípicos por valores umbral.
set.seed(10)
df_tukey=prep_outliers(data = datos_imputados_knn, input = variables, type='stop', method = "tukey")## Warning in prep_outliers(data = datos_imputados_knn, input = variables, : Skip
## the transformation (top value) for some variables because the threshold would
## have left them with 1 unique value. Variable list printed in the console.
## Variables to adjust top threshold: PATRIMONIO
2.Reemplazando los valores atípicos por la mediana.
set.seed(10)
#Identificar los valores atípicos y sustituirlos por la mediana
df_median = datos_imputados_knn #hacer una copia de los datos
cols <- names(df_median)[sapply(df_median, is.numeric)]
for (i in cols) {
q1 <- quantile(df_median[[i]], 0.25)
q3 <- quantile(df_median[[i]], 0.75)
iqr <- q3 - q1
fence1 <- q1 - 1.5 * iqr
fence2 <- q3 + 1.5 * iqr
outliers <- df_median[[i]] < fence1 | df_median[[i]] > fence2
if (any(outliers)) {
df_median[outliers, (i) := median(df_median[[i]], na.rm = TRUE)]
}
}Ahora se comparan las estadísticas de los datos originales y los datos obtenidos después de tratarlos con dos métodos.
profiling_num(datos_imputados_knn) %>% select(variable, mean, std_dev, variation_coef) #datos antes de la imputación## variable mean std_dev variation_coef
## 1 VALOR_VIVIENDA 87559.4635 89852.69605 1.0261906
## 2 PATRIMONIO 0.0000 0.00000 NaN
## 3 IMPORTE 7880.7922 5123.86950 0.6501719
## 4 CUOTA 186.6622 101.37192 0.5430768
## 5 INGRESOS 17294.5988 7585.49605 0.4386049
## 6 SALDO 1426.7224 1984.33862 1.3908373
## 7 EDAD 43.9237 12.04825 0.2742995
profiling_num(df_tukey) %>% select(variable, mean, std_dev, variation_coef) #Datos tras aplicar el método tukey## variable mean std_dev variation_coef
## 1 VALOR_VIVIENDA 93645.73815 102539.71088 1.0949747
## 2 PATRIMONIO 9730.86270 40940.12904 4.2072456
## 3 IMPORTE 8619.14885 6452.02268 0.7485684
## 4 CUOTA 196.30377 118.27922 0.6025316
## 5 INGRESOS 18895.73560 10326.56950 0.5465026
## 6 SALDO 2983.78159 4513.85526 1.5127968
## 7 EDAD 43.97473 12.13794 0.2760208
profiling_num(df_median) %>% select(variable, mean, std_dev, variation_coef)#Datos tras aplicar el método de la mediana## variable mean std_dev variation_coef
## 1 VALOR_VIVIENDA 87559.4635 89852.69605 1.0261906
## 2 PATRIMONIO 0.0000 0.00000 NaN
## 3 IMPORTE 7880.7922 5123.86950 0.6501719
## 4 CUOTA 186.6622 101.37192 0.5430768
## 5 INGRESOS 17294.5988 7585.49605 0.4386049
## 6 SALDO 1426.7224 1984.33862 1.3908373
## 7 EDAD 43.9237 12.04825 0.2742995
Hemos aplicado dos métodos de imputación de valores atípicos y hemos comparado sus resultados. Observamos que no hay mucha diferencia en general cuando se aplica el método Tukey y los valores atípicos se han sustituido por valores umbral, sólo unas pocas variables muestran diferencias en los valores medios. Por otra parte, los valores medios cuando los valores atípicos se sustituyen por medianas, son mucho más similares a los valores antes de la imputación. En el caso de la variable PATRIMONIO, el valor medio es cero porque hay demasiados ceros en los datos. Podemos ignorarlos porque no me parece lógico sustituirlos por ningún otro valor. Dado que los resultados son algo similares a los del conjunto de datos original sin imputación, seguiremos adelante únicamente con este ultimo conjunto de datos(datos_imputados_knn).
Antes de proceder al equilibrado de la muestra, vamos a tomar sólo aquellas variables que son significativas para predecir la CLASE
modelo = glm(CLASE ~., data = datos_imputados_knn, family = "binomial")
summary(modelo)##
## Call:
## glm(formula = CLASE ~ ., family = "binomial", data = datos_imputados_knn)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.7137 0.1013 0.1964 0.3730 1.9462
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.244e+00 6.122e-01 3.665 0.000247 ***
## TIPO_VIVIENDAOtros 1.582e-01 3.834e-01 0.413 0.679833
## TIPO_VIVIENDAPropiedad hipotecada 6.994e-01 3.860e-01 1.812 0.069982 .
## TIPO_VIVIENDAPropiedad libre 1.608e+00 5.809e-01 2.769 0.005631 **
## TIPO_VIVIENDAVive con la familia 4.307e-01 3.078e-01 1.399 0.161711
## VALOR_VIVIENDA 3.627e-06 2.572e-06 1.410 0.158415
## PATRIMONIO NA NA NA NA
## NACIONALIDADExtranjero -1.615e+00 2.477e-01 -6.519 7.08e-11 ***
## IMPORTE 2.289e-04 3.975e-05 5.759 8.48e-09 ***
## CUOTA -7.993e-03 1.706e-03 -4.685 2.80e-06 ***
## INGRESOS 3.042e-06 1.591e-05 0.191 0.848375
## SALDO 4.666e-04 1.151e-04 4.052 5.08e-05 ***
## EDAD -5.231e-03 1.050e-02 -0.498 0.618370
## ESTADO_CIVILSeparado -1.434e+00 3.875e-01 -3.702 0.000214 ***
## ESTADO_CIVILSoltero -1.046e+00 2.505e-01 -4.178 2.94e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1067.53 on 1645 degrees of freedom
## Residual deviance: 718.37 on 1632 degrees of freedom
## AIC: 746.37
##
## Number of Fisher Scoring iterations: 7
library(broom)##
## Attaching package: 'broom'
## The following object is masked from 'package:DMwR':
##
## bootstrap
tidy(modelo)## # A tibble: 15 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 2.24 0.612 3.67 2.47e- 4
## 2 TIPO_VIVIENDAOtros 0.158 0.383 0.413 6.80e- 1
## 3 TIPO_VIVIENDAPropiedad hipotecada 0.699 0.386 1.81 7.00e- 2
## 4 TIPO_VIVIENDAPropiedad libre 1.61 0.581 2.77 5.63e- 3
## 5 TIPO_VIVIENDAVive con la familia 0.431 0.308 1.40 1.62e- 1
## 6 VALOR_VIVIENDA 0.00000363 0.00000257 1.41 1.58e- 1
## 7 PATRIMONIO NA NA NA NA
## 8 NACIONALIDADExtranjero -1.61 0.248 -6.52 7.08e-11
## 9 IMPORTE 0.000229 0.0000397 5.76 8.48e- 9
## 10 CUOTA -0.00799 0.00171 -4.68 2.80e- 6
## 11 INGRESOS 0.00000304 0.0000159 0.191 8.48e- 1
## 12 SALDO 0.000467 0.000115 4.05 5.08e- 5
## 13 EDAD -0.00523 0.0105 -0.498 6.18e- 1
## 14 ESTADO_CIVILSeparado -1.43 0.387 -3.70 2.14e- 4
## 15 ESTADO_CIVILSoltero -1.05 0.250 -4.18 2.94e- 5
También podemos utilizar el software WEKA para la selección de variables. A continuación, se muestra una imagen con el resultado de haber aplicado un método Ranker.
Las dos formas de la selección de variables me dieron resultados diferentes. Basándome en ambos resultados, sólo voy a dejar fuera las variables EDAD,INGRESOS,PATRIMONIO. Estas variables se excluirán al obtener una muestra equilibrada utilizando el método del cubo.
Antes de realizar el método del cubo recordamos con una simple tabla los registros de nuestra variable de clasificación, CLASE.
t2 <- table(datos_imputados_knn$CLASE)
addmargins(t2)##
## NO SI Sum
## 164 1482 1646
Muestreo aleatorio
datos1482 <- subset(datos_imputados_knn, CLASE == "SI")
datos164 <- subset(datos_imputados_knn, CLASE == "NO")
#Tamaño de la muestra
n <-164
set.seed(0)
muestra <- sample(1:nrow(datos1482),size=n,replace=FALSE)
muestra164 <- datos1482[muestra, ]
datos_aleatorios_328 <- rbind(muestra164, datos164) #Muestra final 1
# Conjunto de datos equilibrado
summary(datos_aleatorios_328)## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD
## Alquiler :81 Min. : 0 Min. :0 Español :219
## Otros :23 1st Qu.: 0 1st Qu.:0 Extranjero:109
## Propiedad hipotecada:91 Median : 0 Median :0
## Propiedad libre :59 Mean : 62743 Mean :0
## Vive con la familia :74 3rd Qu.:120000 3rd Qu.:0
## Max. :350000 Max. :0
## IMPORTE CUOTA INGRESOS SALDO
## Min. : 400 Min. : 22.0 Min. : 0 Min. :-920.00
## 1st Qu.: 3000 1st Qu.:104.0 1st Qu.:12406 1st Qu.: 17.75
## Median : 6000 Median :180.0 Median :15235 Median : 272.50
## Mean : 7092 Mean :186.5 Mean :15962 Mean :1031.19
## 3rd Qu.: 9000 3rd Qu.:250.0 3rd Qu.:19539 3rd Qu.: 977.25
## Max. :22400 Max. :470.0 Max. :35649 Max. :9036.00
## EDAD ESTADO_CIVIL CLASE
## Min. :20.00 Casado :137 NO:164
## 1st Qu.:32.00 Separado: 20 SI:164
## Median :42.00 Soltero :171
## Mean :41.51
## 3rd Qu.:49.25
## Max. :75.00
head(datos_aleatorios_328)## TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE CUOTA
## 1: Propiedad libre 300000 0 Español 20500 193
## 2: Vive con la familia 0 0 Español 20000 399
## 3: Propiedad libre 125000 0 Español 9000 250
## 4: Vive con la familia 0 0 Español 6000 146
## 5: Vive con la familia 0 0 Español 9000 250
## 6: Vive con la familia 0 0 Español 18000 365
## INGRESOS SALDO EDAD ESTADO_CIVIL CLASE
## 1: 17263 102 48 Casado SI
## 2: 13255 8821 22 Soltero SI
## 3: 30791 2861 57 Casado SI
## 4: 5745 -120 55 Soltero SI
## 5: 19693 2960 35 Casado SI
## 6: 13300 774 32 Soltero SI
Muestreo con el método del cubo.
# Datos donde efectuamos la selección de las transacciones datos_SIs
datos_SI = datos_imputados_knn[ datos_imputados_knn$CLASE == "SI", ]
# Número de transacciones datos_SI
datos_SIs = nrow(datos_SI)
# Creamos las variables indicadores para cada una de las variables de equilibrio.
# Variable que vale 1 en todas las partes (para comprobar la estimación del tamaño poblacional)
UNO = rep(1, datos_SIs)
# Variables cuantitativas
X1 = datos_SI[ , c("VALOR_VIVIENDA", "IMPORTE", "SALDO", "CUOTA")]
# Variables cualitativas
X2 <- disjunctive(datos_SI$TIPO_VIVIENDA)
colnames(X2) <- levels(datos_SI$TIPO_VIVIENDA)
X3 <- disjunctive(datos_SI$NACIONALIDAD)
colnames(X3) <- levels(datos_SI$NACIONALIDAD)
X4 <- disjunctive(datos_SI$ESTADO_CIVIL)
colnames(X4) <- levels(datos_SI$ESTADO_CIVIL)
# Matriz de diseño
X = as.matrix(cbind(UNO, X1,X2,X3,X4))
# Tamaño de la muestra
s.datos = 164
# Probabilidades de inclusión
pik = rep(s.datos / datos_SIs, datos_SIs)
# extracción de la muestra
# method = 2 para una fase de aterrizaje por supresión de variables
# order =1 los datos se ordenan aleatoriamente
set.seed(012)
s = samplecube( X, pik, method = 2, order = 1, comment = FALSE )
# Generación de fichero resultante
muestra.datos_SI = cbind( datos_SI, s )
muestra.datos_SI = muestra.datos_SI[ muestra.datos_SI$s == 1, ]
muestra.datos_SI$s = NULLDebemos comprobar la calidad de nuestro muestreo, para lo cual recurrimos a los estimadores de Horvitz-Thompson y vemos, en la última columna, la desviación de cada media en porcentaje. En este caso, sólo dos niveles “otros” y “Separados” de diferentes variables han mostrado alguna desviación en sus valores medios. Sin embargo, para la mayoría de las variables no hay mucha desviación.
# Calidad de la muestra obtenida
Totales = apply(X, 2, sum)
Horvitz.Thompson = apply(X * s / pik, 2, sum)
calidad = cbind.data.frame(Totales, Horvitz.Thompson)
calidad$Desv.Abs. = round(calidad$Totales - calidad$Horvitz.Thompson, 2)
calidad$Desv.Rel. = round((calidad$Totales / calidad$Horvitz.Thompson - 1) *100, 2)
print(as.matrix.data.frame(calidad))## Totales Horvitz.Thompson Desv.Abs. Desv.Rel.
## UNO 1482 1.482000e+03 0.00 0.00
## VALOR_VIVIENDA 140400040 1.409474e+08 -547395.39 -0.39
## IMPORTE 12039435 1.205381e+07 -14375.85 -0.12
## SALDO 2282547 2.257294e+06 25253.16 1.12
## CUOTA 279453 2.793931e+05 59.85 0.02
## Alquiler 128 1.265122e+02 1.49 1.18
## Otros 61 6.325610e+01 -2.26 -3.57
## Propiedad hipotecada 562 5.602683e+02 1.73 0.31
## Propiedad libre 457 4.608659e+02 -3.87 -0.84
## Vive con la familia 274 2.710976e+02 2.90 1.07
## Español 1336 1.337415e+03 -1.41 -0.11
## Extranjero 146 1.445854e+02 1.41 0.98
## Casado 815 8.132927e+02 1.71 0.21
## Separado 76 8.132927e+01 -5.33 -6.55
## Soltero 591 5.873780e+02 3.62 0.62
No utilizo el método SMOTE porque no es necesario un sobremuestreo de la clase minoritaria, ya que dispongo de 164 observaciones para obtener un conjunto de muestras equilibradas de 328. Además, me parece más lógico conservar las observaciones originales que crear muestras sintéticas, ya que así se evitan los sesgos.
# Fichero final con las muestras balanceadas
# Conjunto de datos resultante
datos_mdc_328 = rbind(muestra.datos_SI, datos164) #Muestra final 2
dim(datos_mdc_328)## [1] 328 11
# Tabla de frecuencias de la variable dependiente para observar que los datos están ya balanceados
table(datos_mdc_328$CLASE)##
## NO SI
## 164 164
Comparación de variables
Ahora vamos a comparar las dos muestras con los datos originales y comprobar si hay muchas diferencias en sus parametros.
Variable: IMPORTE
Considerando la variable numérica IMPORTE y analizando los resultados obtenidos, podemos observar que la media y la mediana de los datos originales sin imputación difiere de la de esas dos muestras obtenidas por métodos diferentes. Sin embargo, los resultados de las dos muestras son algo similares.
data1_var <- pull(datos_imputados_knn, "IMPORTE")
data2_var <- pull(datos_aleatorios_328, "IMPORTE")
data3_var <- pull(datos_mdc_328, "IMPORTE")
set.seed(0)
sumario <- tibble(
Datos = c("Datos originales", "Datos equilibrados con selección aleatoria", "Datos equilibrados con muestra del método del cubo"),
Media = c(mean(data1_var), mean(data2_var), mean(data3_var)),
Mediana = c(median(data1_var), median(data2_var), median(data3_var))
)
sumario## # A tibble: 3 × 3
## Datos Media Mediana
## <chr> <dbl> <dbl>
## 1 Datos originales 7881. 9000
## 2 Datos equilibrados con selección aleatoria 7092. 6000
## 3 Datos equilibrados con muestra del método del cubo 6909. 6000
par(mfrow = c(1, 3))
mean1 <- mean(datos_imputados_knn$IMPORTE)
mean2 <- mean(datos_aleatorios_328$IMPORTE)
mean3 <- mean(datos_mdc_328$IMPORTE)
median1 <- median(datos_imputados_knn$IMPORTE)
median2 <- median(datos_aleatorios_328$IMPORTE)
median3 <- median(datos_mdc_328$IMPORTE)
ggplot(datos_imputados_knn, aes(x = IMPORTE)) +
geom_histogram(binwidth = 500, color = "black", fill = "white") +
geom_vline(aes(xintercept = mean1), color = "blue", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median1), color = "red", linetype = "dashed", size = 1) +
labs(title = "Datos originales",
x = "IMPORTE", y = "Frecuencia")+
scale_x_continuous(limits = c(0, 30000))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## Warning: Removed 2 rows containing missing values (`geom_bar()`).
ggplot(datos_aleatorios_328, aes(x = IMPORTE)) +
geom_histogram(binwidth = 500, color = "black", fill = "white") +
geom_vline(aes(xintercept = mean2), color = "blue", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median2), color = "red", linetype = "dashed", size = 1) +
labs(title = "Datos equilibrados con selección aleatoria",
x = "IMPORTE", y = "Frecuencia")ggplot(datos_mdc_328, aes(x = IMPORTE)) +
geom_histogram(binwidth = 500, color = "black", fill = "white") +
geom_vline(aes(xintercept = mean3), color = "blue", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median3), color = "red", linetype = "dashed", size = 1) +
labs(title = "Datos equilibrados con método de cubo",
x = "IMPORTE", y = "Frecuencia")Variable: TIPO_VIVIENDA
Considerando la variable categórica TIPO_VIVIENDA y observando los resultados obtenidos, podemos comparar la frecuencia y el porcentaje de niveles de la variable obtenidos en los tres casos. Podemos observar que mientras en la base de datos original los diferentes niveles estaban distribuidos de forma desigual, en el caso de las muestras equilibradas, en ambos casos los datos están distribuidos de forma más uniforme. Aunque ninguno de los métodos de muestreo puede considerarse mejor que otro, cada método tiene sus pros y sus contras.
par(mfrow = c(1, 3))
freq(datos_imputados_knn$TIPO_VIVIENDA)## var frequency percentage cumulative_perc
## 1 Propiedad hipotecada 590 35.84 35.84
## 2 Propiedad libre 463 28.13 63.97
## 3 Vive con la familia 316 19.20 83.17
## 4 Alquiler 200 12.15 95.32
## 5 Otros 77 4.68 100.00
freq(datos_aleatorios_328$TIPO_VIVIENDA)## var frequency percentage cumulative_perc
## 1 Propiedad hipotecada 91 27.74 27.74
## 2 Alquiler 81 24.70 52.44
## 3 Vive con la familia 74 22.56 75.00
## 4 Propiedad libre 59 17.99 92.99
## 5 Otros 23 7.01 100.00
freq(datos_mdc_328$TIPO_VIVIENDA)## var frequency percentage cumulative_perc
## 1 Propiedad hipotecada 90 27.44 27.44
## 2 Alquiler 86 26.22 53.66
## 3 Vive con la familia 72 21.95 75.61
## 4 Propiedad libre 57 17.38 92.99
## 5 Otros 23 7.01 100.00